;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                ;;;
;;;                           cl-famix                             ;;;
;;;                     (Common Lisp FAMIX library)                ;;;
;;;                        by Adrian DOZSA                         ;;;
;;;                                                                ;;;
;;;                        Utility Functions                       ;;;
;;;                                                                ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; cl-famix package
 
(in-package :cl-famix)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Auxiliary functions

(defmacro not-null (var)
  `(not (null ,var)))

(defun file-name (pathname)
  (let ((name (pathname-name pathname))
        (type (pathname-type pathname)))
    (concatenate  'string
                  name
                  (unless (null type) ".")
                  type)))

(defmacro ignore-warnings (&body forms) 
   `(handler-case (progn ,@forms) 
      (warning (c) (values nil c))))

(defmacro with-package (package-symbol &body forms)
  `(let ((*package* (find-package ,package-symbol)))
     (progn ,@forms)))

(defun list-macros-from-package (package-symbol)
  (let ((package (find-package package-symbol))
        (macros-list nil))
    (do-symbols (sym package)
      (when (macro-function sym)                
        (multiple-value-bind 
            (in? type) 
            (find-symbol (string sym) package)
          (when (and in?
                     (not (equal type :inherited)))
            (setq macros-list (cons sym macros-list))))))
    macros-list))

(defun flat-list-p (list)
  (and (listp list)
       (listp (cdr list))
       (notany #'listp list)))

(defun regular-list (list)
  (if (null list)
      t
    (and (listp (cdr list))
         (regular-list (cdr list)))))

(defun find-depth (element list)
  (if (flat-list-p list)
      (find element list)
    (or
     (if (listp (first list))
         (find-depth element (first list))
       (when (equal element (first list))
         element))
     (find-depth element (rest list)))))

(defun find-def (element list)
  (when (listp list)
    (if (equal (first list)
               element)
        list
      (when (regular-list list)
        (loop for x in (cdr list)
              when (listp x)
              for found = (find-def element x)
              while (null found)
              finally return found)))))

(defun get-method-specialization-list (lambda-list)
  (mapcar #'(lambda (param-def)
              (if (listp param-def)
                  (if (listp (second param-def))
                      'EQL
                    (second param-def))
                'T))
          lambda-list))

(defun complexity (form)
  (if (and (listp form)
           (no-dot-list form))
      (1+
       (reduce #'+ (mapcar #'complexity form)))
    0))

(defun no-dot-list (list)
  (if list
      (and (listp (cdr list))
           (no-dot-list (cdr list)))
    t))


;; ID counter

(defvar *id-gen* 1) ;(make-counter))

(defun new-id-value ()
  (incf *id-gen*))

(defun reset-id-gen ()
  (setf *id-gen* 1))

#|
(defun make-counter ()
  (let ((i 1))
    #'(lambda ()
        (incf i)))) 

(defmacro new-value (counter)
  `(funcall ,counter))

(defmacro reset-counter (counter)
  `(setf ,counter (make-counter)))
|#


#|
;;; Old stuff

(defun read-file (file)
  (with-open-file (stream file)
    (loop for line = (read-line stream nil)
          while line
          for file-content = (concatenate 'string
                                          file-content 
                                          line
                                          (string #\Newline))
          finally return file-content)))

(defun remove-read-eval (string)
  (loop for i = (search "#.(" string)
        then (search "#.(" string :start2 (1+ i))
        while i
        do
        (setf (char string i) #\Space)
        (setf (char string (1+ i)) #\Space)
        finally return string))
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
